home *** CD-ROM | disk | FTP | other *** search
/ Amiga Collections: Franz PD / Franz PD Disk #216 (1993)(Rhein-Sieg-Soft)(Disk 1 of 2).zip / Franz PD Disk #216 (1993)(Rhein-Sieg-Soft)(Disk 1 of 2).adf / Etikett / Eti2 (.txt) < prev    next >
AmigaBASIC Source Code  |  1993-02-02  |  33KB  |  1,077 lines
  1. REM Etikettendruck, Version 1.10, 80 Zeichen 
  2. REM Lothar Berndt, 4240 Emmerich 1, 1988/89/90
  3. Init:
  4. DEFINT a-z:FOR i=1 TO 4:MENU i,0,0,"":NEXT i
  5. Version$="Etikettendruck, Version 1.10"
  6. ON ERROR GOTO Fehler
  7. ON BREAK GOSUB ControlC:BREAK ON
  8. IF FRE(-1)>390000 THEN
  9.   SNr=1:SCREEN SNr,640,256,2,2:bs=1
  10.   ELSE
  11.   SNr=-1:bs=0
  12. END IF
  13.   WINDOW 3,,(0,190)-(630,206),16,SNr:WINDOW CLOSE 1
  14.   WNr=2:WINDOW WNr,Version$,(0,0)-(630,175),22,SNr:wpr&=WINDOW(7)
  15.   OPEN"Farbdaten" FOR INPUT AS 1
  16.   INPUT#1,Farbzahl:DIM Farbwert!(Farbzahl,3)
  17.   FOR i=0 TO Farbzahl:FOR J=1 TO 3
  18.   INPUT#1,Farbwert!(i,J):NEXT J
  19.   PALETTE i,Farbwert!(i,1),Farbwert!(i,2),Farbwert!(i,3):NEXT i:CLOSE 1
  20.   WINDOW OUTPUT 3:GOSUB Text1:WINDOW OUTPUT WNr
  21.   CLS:LOCATE 11,31:PRINT "LESE LIBRARIES EIN"
  22.   DECLARE FUNCTION Examine& LIBRARY
  23.   DECLARE FUNCTION ExNext& LIBRARY
  24.   DECLARE FUNCTION Lock& LIBRARY
  25.   DECLARE FUNCTION AllocRemember& LIBRARY
  26.   dos.lib
  27.   intuition.lib
  28.   CLS:LOCATE 11,31:PRINT "VORBEREITUNGEN"
  29.   anz=50
  30.   DIM SHARED DirName$(anz),DirSize&(anz),DirBlks&(anz)
  31.   n=1300 :REM MaxAnzahl Datensätze (Etiketten)
  32.   m=15   :REM MaxAnzahl Felder -1 (0-15 = 16 Felder)
  33.   MaxAnzahlFelder=m
  34.   DIM mo$(10),ra$(7),a$(m),f$(m),la(m)
  35.   loesch$="":dn$="":fe$="":c$="":t$="":fuell$=".":Fett=0:Doppel=0
  36.   l=3:p=3:abbruch=3:FelderJN=0:x=0:y=0:i=0:f=0:r=0:ll=0:mm=0
  37.   eingerichtet=0:RelOffen=0:Dateigroesse&=0:win=0:u=0:c=0:openreq=0
  38.   counter=0:qo=0:gespeichert=0:an=0:ze=0:tt=0:bx=6:hy=8:tst=0:erg&=0
  39.   Satzlaenge=0:SatzNr=0:record=0:fl=0:Format=0:px1=0:py1=0:px2=0:py2=0:pa1=0
  40.   jj=4000:qa=0:me=0:FehlerNr=0:win=0:req=0:px=0:py=0:xp=0:yp=0
  41.   suffix$=".eti"  '(Rel-Datei)
  42.   suffix2$=".par" '(Seq-Datei) Parameter
  43.   ra$(0)=""
  44.   ra$(1)="ERSTES ETIKETT"  
  45.   ra$(2)="LETZTES ETIKETT"  
  46.   ra$(3)="Maximale Anzahl erreicht"
  47.   ra$(4)="Daten ausgeben "
  48.   ra$(5)="Etiketten-Screen"+CHR$(0)
  49.   ra$(6)="Das geht nicht!"
  50.   ra$(7)="Sicher?"
  51.   mo$(0)="Datei öffnen oder einrichten"
  52.   mo$(1)="Datei einrichten, Dateinamen eingeben"
  53.   mo$(2)="Datei einrichten, Format bestimmen"
  54.   mo$(3)="Etiketten eingeben"
  55.   mo$(4)="Etiketten ausgeben"
  56.   mo$(5)=""
  57.   mo$(6)=""
  58.   mo$(7)=""
  59.   mo$(8)="Datei öffnen"
  60.   mo$(9)="Datei von Diskette löschen"
  61.   mo$(10)="Beenden"
  62.   Etikett$(0)="Ein Etikett im Format 70 X 36 mm drucken"
  63.   Etikett$(1)="Ein Etikett im Format 70 X 70 mm drucken"
  64.   Etikett$(2)="Ein Etikett im Format 89 X 36 mm drucken"
  65.   es$=CHR$(27):af$=CHR$(34):RIS$=es$+"c"
  66.   RIN$=es$+"#1":SRG0$=es$+"[0m":SRG1$=es$+"[1m":SRG22$=es$+"[22m"
  67.   SHORP0$=es$+"[0w":SHORP2$=es$+"[2w":SHORP1$=es$+"[1w":SHORP6$=es$+"[6w"
  68.   SHORP5$=es$+"[5w":SHORP4$=es$+"[4w":SHORP3$=es$+"[3w"
  69.   SUS2$=es$+"[2v":SUS1$=es$+"[1v":SUS4$=es$+"[4v":SUS3$=es$+"[3v"
  70.   DEN2$=es$+"[2"+af$+"z":DEN1$=es$+"[1"+af$+"z"
  71.   DEN4$=es$+"[4"+af$+"z":DEN3$=es$+"[3"+af$+"z"
  72.   MENU 1,0,1,"Datei"
  73.   MENU 1,1,1,"Einrichten ":MENU 1,2,1,"Öffnen     "
  74.   MENU 1,3,0,"Schließen  ":MENU 1,4,1,"Löschen    "
  75.   MENU 1,5,1,"Verzeichnis":MENU 1,6,1,"Ende       "
  76.   MENU 2,0,0,"Etiketten"
  77.   MENU 2,1,1,"Eingeben ":MENU 2,2,1,"Drucken  ":MENU 2,3,1,"Farbe    "
  78.   MENU 3,0,0,"Info"
  79.   MENU 3,1,1,"Programm":MENU 3,2,1,"Datei   "
  80.   MENU 3,3,1,"EtiDruck":MENU 3,4,1,"Tasten  "
  81.   CLS:GOSUB Titel
  82.   IF bs=1 THEN GOSUB TitleS
  83.   SetTitle"Verzeichnis lesen"
  84.   Dir$="Daten":GOSUB GetDir:gespeichert=0:SortDir
  85.   SetTitle"Datei öffnen oder einrichten"
  86.   ON MENU GOSUB Auswahl:MENU ON
  87. Wa1:
  88.   SLEEP
  89.   GOTO Wa1
  90. Auswahl:
  91. ON MENU(0) GOTO men1,men2,men3
  92. men1: ON MENU(1) GOTO Einrichten,Laden,Schliessen,DateiLoeschen,Verz,Ende               
  93. men2: ON MENU(1) GOTO Eingabe,Drucken,Farbe
  94. men3: ON MENU(1) GOTO Prg,Datei,Eti,Tas
  95. '----------------------
  96. '*** Unterprogramme ***
  97. '----------------------
  98. MenuesAus:
  99.   FOR i=1 TO 3:MENU i,0,0:NEXT i:MENU OFF:RETURN
  100. MenuesAn:
  101.   FOR i=1 TO 3:MENU i,0,1:NEXT i:MENU ON:RETURN
  102. Titel:
  103.   LOCATE 9,28 :PRINT"E T I K E T T E N D R U C K"
  104.   LOCATE 11,28:PRINT"Lothar Berndt  1988, 89, 90"
  105.   LOCATE 13,35:PRINT RIGHT$(Version$,12)
  106. RETURN
  107. Text1:
  108.   LINE(12,1)-(104,11),2,bf:LINE(114,1)-(206,11),2,bf  'Ändern/Anfang
  109.   LINE(215,1)-(259,11),2,bf:LINE(265,1)-(309,11),2,bf '<<< <
  110.   LINE(315,1)-(359,11),2,bf:LINE(365,1)-(409,11),2,bf '> >>> 
  111.   LINE(418,1)-(510,11),2,bf:LINE(520,1)-(612,11),2,bf 'ENDE/LÖSCHEN
  112.   LINE(12,14)-(206,24),2,bf:LINE(215,14)-(409,24),2,bf     
  113.   LINE(418,14)-(510,24),2,bf:LINE(520,14)-(612,24),2,bf:COLOR 1,2
  114.   xyPTAB 35,9:PRINT "ÄNDERN";:PRINT PTAB(137)"ANFANG";PTAB(226)"<<<";
  115.   PRINT PTAB(283)"<";PTAB(335)">";PTAB(377)">>>";PTAB(450)"ENDE"
  116.   LOCATE 3,5:PRINT "ETIKETTNUMMER SUCHEN";PTAB(238)"EIN ETIKETT DRUCKEN";
  117.   PRINT PTAB(430)"FETTDRUCK";PTAB(523)"DOPPELDRUCK";:COLOR 1,0
  118. RETURN
  119. 650 FOR i=1 TO jj:NEXT i:RETURN
  120. DateiNameEingabe:
  121.   wt$="Dateinamen eingeben: ":GOSUB OpenWin4
  122.   c$=STRING$(14,32):getline 2,3,14,c$,3,0
  123.   c$=LEFT$(c$,p-1):FOR f=LEN(c$) TO 13:c$=c$+fuell$:NEXT f
  124.   dn$="Daten/"+c$+suffix$
  125.   fe$="Daten/"+c$+suffix2$:WINDOW CLOSE 4:c$="":RETURN
  126. OpenWin4:
  127.   WINDOW 4,wt$,(218,100)-(406,150),0,SNr
  128.   LINE (14,5)-(130,18),,b :REM *** Rahmen um Cursor
  129.   LINE (14,28)-(80,42),2,bf:LINE (110,28)-(176,42),2,bf:COLOR 1,2
  130.   LOCATE 5,1:PRINT PTAB(38)"OK";PTAB(116)"ABBRUCH";:COLOR 1,0:RETURN
  131. Info:
  132.   WINDOW 5,"Info:",(218,100)-(406,150),0,SNr:RETURN
  133. Kopfzeile:
  134.   CLS:LOCATE 1,44:COLOR 2:PRINT"Frei System:";:COLOR 1:PRINT FRE(-1)
  135.   COLOR 2,0:LOCATE 1,2:PRINT"Etikett Nr.:":COLOR 1
  136.   COLOR 2:LOCATE 1,23
  137.   IF Format=1 THEN PRINT"Format 70 X 36"
  138.   IF Format=2 THEN PRINT"Format 70 X 70"
  139.   IF Format=3 THEN PRINT"Format 89 X 36"
  140.   LOCATE 3,2:PRINT"Etik. belegt:";:COLOR 1:PRINT an:COLOR 2
  141.   LOCATE 3,23:PRINT"Etik. frei:";:COLOR 1:PRINT n-an:COLOR 2
  142.   LOCATE 3,44:PRINT"Dateiname: ";:COLOR 1:PRINT LEFT$(dn$,20):RETURN
  143. Loeschen:
  144.   LOCATE 5,1:FOR ll=0 TO m:PRINT SPC(14)STRING$(la,32):NEXT ll
  145.   LOCATE 1,16:PRINT SPACE$(4):RETURN
  146. Rahmen:  
  147.   LINE (106,28)-((la*hy)+(19*bx)+3,42+(m*hy)),,b
  148.   FOR f=1 TO m+1:LOCATE 4+f,3:PRINT"Zeile ";f:NEXT f:RETURN
  149. Info70X70:
  150.   COLOR 3,0:FOR i=0 TO 3:LOCATE 5+i,49:PRINT"Frei lassen":NEXT i
  151.   LOCATE 7,49:PRINT"Hier Disknummer u. Disknamen" 
  152.   LOCATE 9,49:PRINT"Hier Disknummer eingeben":COLOR 1,0:RETURN
  153. GetDir:
  154.   counter=1:Dir$=Dir$+CHR$(0):Lo&=Lock&(SADD(Dir$),-2) 
  155.   IF Lo&=0 THEN ERROR 75
  156.   Info&=AllocRemember&(0,252,65538)
  157.   IF Info&=0 THEN CALL UnLock&(Lo&):ERROR 76
  158.   suc&=Examine&(Lo&,Info&)
  159.   IF suc&=0 THEN GOSUB Fin:ERROR 77
  160.   again:
  161.   DirName&=Info&+8
  162.   FOR search=0 TO 29
  163.     check=PEEK(DirName&+search)
  164.     IF check<>0 THEN check$=check$+CHR$(check) :ELSE search=29
  165.   NEXT search
  166.   IF RIGHT$(check$,4)=suffix$ THEN
  167.     DirName$(counter)=check$:check$=""
  168.     DirSize&(counter)=PEEKL(Info&+124)
  169.     DirBlks&(counter)=PEEKL(Info&+128)
  170.     counter=counter+1
  171.      ELSE
  172.     check$="" 
  173.   END IF
  174.   suc&=ExNext&(Lo&,Info&)
  175.   IF suc&=0 THEN
  176.     GOTO Fin
  177.     ELSE
  178.     IF counter<=anz THEN again
  179.   END IF
  180.   Fin: CALL FreeRemember&(0,-1):CALL UnLock&(Lo&)
  181. RETURN
  182. TitleS: st&=SADD(ra$(5)):CALL SetWindowTitles&(wpr&,-1,st&):RETURN
  183. st: SetTitle mo$(0):RETURN
  184. DNam: LOCATE 2,25:PRINT"Dateiname: ";LEFT$(dn$,20):RETURN
  185. '----------
  186. Einrichten:
  187. '----------
  188.   MENU 1,1,0:MENU OFF
  189.   CLS:SetTitle mo$(1):GOSUB DateiNameEingabe
  190.   IF abbruch=1 AND FelderJN=0 THEN
  191.     abbruch=0:WINDOW CLOSE 4:GOSUB st:MENU 1,1,1
  192.    dn$="":fe$="":CLS:MENU ON:RETURN
  193.   END IF
  194.   IF dn$="Daten/"+STRING$(14,46)+suffix$ THEN
  195.    WINDOW CLOSE 4:GOSUB Info:COLOR 3,0:LOCATE 3,5:PRINT ra$(6)
  196.    GOSUB 650:WINDOW CLOSE 5:GOSUB st:MENU 1,1,1
  197.    dn$="":fe$="":CLS:MENU ON:RETURN
  198.   END IF
  199.   GOSUB DNam:CALL Dateitest(dn$,erg&)
  200.   IF erg&>0 THEN
  201.     LOCATE 10,24:PRINT"Die Datei existiert bereits!"
  202.     Requester" Überschreiben?","JA","  Nein"
  203.     IF req=2 THEN
  204.       GOSUB st:MENU 1,1,1:dn$="":fe$="":c$="":CLS:MENU ON:RETURN
  205.     END IF
  206.   END IF
  207. Felder2:
  208.   CLS:SetTitle mo$(2):GOSUB DNam
  209.   LOCATE 5,29:PRINT"1 = Format 70 X 36 mm"
  210.   LOCATE 7,29:PRINT"2 = Format 70 X 70 mm"
  211.   LOCATE 9,29:PRINT"3 = Format 89 X 36 mm"
  212.   wt$="Format 1, 2 oder 3":GOSUB OpenWin4
  213.   c$=SPACE$(1):getline 2,3,1,c$,3,0
  214.   IF abbruch=1 AND FelderJN=0 THEN
  215.     abbruch=0:WINDOW CLOSE 4:GOSUB st:MENU 1,1,1
  216.     dn$="":fe$="":c$="":CLS:MENU ON:RETURN
  217.   END IF
  218.   IF c$=SPACE$(1) THEN 
  219.    WINDOW CLOSE 4:GOSUB Info:COLOR 3,0:LOCATE 3,5:PRINT ra$(6)
  220.    GOSUB 650:WINDOW CLOSE 5:GOSUB st:MENU 1,1,1
  221.    dn$="":fe$="":c$="":CLS:MENU ON:RETURN
  222.   END IF
  223.   WINDOW CLOSE 4:Format=ABS(VAL(c$))
  224.   IF Format<1 OR Format>3 THEN Felder2
  225.   IF Format=1 THEN m=7 :FOR i=0 TO m:la(i)=30:NEXT i:la=30
  226.   IF Format=2 THEN m=15:FOR i=0 TO m:la(i)=30:NEXT i:la=30
  227.   IF Format=3 THEN m=7 :FOR i=0 TO m:la(i)=40:NEXT i:la=40
  228.   Requester"Alles OK?","JA","  NEIN"
  229.   ON req GOTO Wa2,Wb2
  230. Wa2: FelderJN=1:GOTO RelEinrichten
  231. Wb2: GOTO Einrichten
  232. RelEinrichten:
  233.   Satzlaenge=0:FOR x=0 TO m:Satzlaenge=Satzlaenge+la(x):NEXT x
  234.   RelOffen=0
  235.   OPEN fe$ FOR OUTPUT AS 1
  236.   WRITE#1,m
  237.   WRITE#1,Satzlaenge
  238.   WRITE#1,Format
  239.   WRITE#1,la
  240.   WRITE#1,an
  241.   WRITE#1,Zeile
  242.   CLOSE 1:KILL fe$+".info":FelderJN=1:gespeichert=1:MENU ON
  243. GOTO Eingabe
  244. Oeffnen:
  245.   OPEN fe$ FOR INPUT AS 1
  246.   INPUT#1,m
  247.   INPUT#1,Satzlaenge
  248.   INPUT#1,Format
  249.   INPUT#1,la:FOR i=0 TO m:la(i)=la:NEXT i
  250.   INPUT#1,an
  251.   INPUT#1,Zeile
  252.   CLOSE 1
  253. Oeffnen2:
  254.   OPEN"R",#2,dn$,Satzlaenge
  255. IF Format=1 OR Format=3 THEN
  256. FIELD #2,la AS a$(0),la AS a$(1),la AS a$(2),la AS a$(3),la AS a$(4),la AS a$(5),la AS a$(6),la AS a$(7)
  257. END IF
  258. IF Format=2 THEN
  259. FIELD #2,la AS a$(0),la AS a$(1),la AS a$(2),la AS a$(3),la AS a$(4),la AS a$(5),la AS a$(6),la AS a$(7),la AS a$(8),la AS a$(9),la AS a$(10),la AS a$(11),la AS a$(12),la AS a$(13),la AS a$(14),la AS a$(15)
  260. END IF
  261. RelOffen=1:an=LOF(2)/Satzlaenge:RETURN
  262. CloseDatei:
  263.   CLOSE 2:RelOffen=0
  264. RETURN
  265. '-------
  266. Eingabe:
  267. '-------
  268.   IF RelOffen=0 THEN GOSUB Oeffnen2
  269.   SatzNr=an+1:CALL ActivateWindow&(wpr&)
  270.   CLS:SetTitle mo$(3):GOSUB MenuesAus:GOSUB Rahmen
  271. Eingabe2:
  272.   IF an=n THEN GOSUB Info:PRINT ra$(3):GOSUB 650:WINDOW CLOSE 5:MENU ON:GOTO DatAus
  273.   GOSUB Loeschen
  274.   LOCATE 1,44:COLOR 2,0:PRINT"FREI SYSTEM:";:COLOR 1,0:PRINT FRE(-1)
  275.   COLOR 2:LOCATE 1,2:PRINT"Etikett Nr.:";:COLOR 1,0:PRINT SatzNr
  276.   LOCATE 3,2:COLOR 2,0:PRINT"Etik. belegt:";:COLOR 1,0:PRINT an:COLOR 2,0
  277.   LOCATE 3,23:PRINT"Etik. frei:";:COLOR 1,0:PRINT n-an:COLOR 2,0
  278.   LOCATE 3,44:PRINT"Dateiname: ";:COLOR 1:PRINT LEFT$(dn$,20)
  279.   FOR i=0 TO m:f$(i)=STRING$(la,32):NEXT i
  280.   IF Format=2 THEN GOSUB Info70X70
  281. Nein:  
  282.   intext m,5,15,la(),f$(),3,0
  283.   FOR f=0 TO m:LSET a$(f)=f$(f):NEXT f
  284.   WINDOW 8,"Eingaben OK?",(200,100)-(440,150),0,SNr
  285.   LINE(20,10)-(80,40),2,bf:LINE(90,10)-(150,40),2,bf
  286.   LINE(160,10)-(220,40),2,bf:COLOR 1,2
  287.   LOCATE 4,1:PRINT PTAB(42)"JA";PTAB(104)"NEIN";PTAB(163)"ABBRUCH":COLOR 1,0
  288. Wa3:
  289.   WHILE MOUSE(0)=0:GOSUB Paint3:SLEEP:WEND
  290.   tst=MOUSE(0):x=MOUSE(1):y=MOUSE(2):win=WINDOW(0) 
  291.   IF win<>8 THEN Wa3
  292.   IF win=8 AND y>10 AND y<40 THEN                
  293.     IF x>20 AND x<80 THEN
  294.       xp=22:PAINT(xp,12),1,0:px=xp:IF MOUSE(0)<0 THEN Wa3
  295.       WINDOW CLOSE 8:GOSUB SatzSchreiben:GOTO Eingabe2
  296.     END IF
  297.     IF x>90  AND x<150 THEN
  298.       xp=92:PAINT(xp,12),1,0:px=xp:IF MOUSE(0)<0 THEN Wa3
  299.       WINDOW CLOSE 8:GOTO Nein
  300.     END IF
  301.     IF x>160 AND x<220 THEN
  302.       xp=162:PAINT(xp,12),1,0:px=xp:IF MOUSE(0)<0 THEN Wa3
  303.       WINDOW CLOSE 8: GOSUB SatzSchreiben:GOSUB CloseDatei
  304.       GOSUB MenuesAn:MENU 2,1,1:MENU 2,2,1:tt=1:GOTO DatAus
  305.     END IF
  306.   END IF
  307. GOTO Wa3
  308. Paint3:
  309.   PAINT(px,12),2,0:COLOR 1,2
  310.   LOCATE 4,1:PRINT PTAB(42)"JA";PTAB(104)"NEIN";PTAB(163)"ABBRUCH":COLOR 1,0
  311. RETURN  
  312. SatzSchreiben:
  313.   PUT #2,SatzNr:an=SatzNr:SatzNr=SatzNr+1:RETURN
  314. EtiSuchen:
  315.   MENU OFF:SetTitle"Etikett suchen"
  316.   wt$="Etikettnummer eingeben: ":GOSUB OpenWin4
  317.   c$=SPACE$(4):getline 2,3,4,c$,3,0
  318.   IF abbruch=1 THEN
  319.    abbruch=0:WINDOW CLOSE 4:GOSUB ModusSetzen:MENU ON:RETURN
  320.    END IF
  321.   IF c$=SPACE$(4) THEN
  322.    WINDOW CLOSE 4:GOSUB Info:LOCATE 3,5:COLOR 3,0:PRINT ra$(6)
  323.    GOSUB 650:WINDOW CLOSE 5:GOSUB ModusSetzen:MENU ON:RETURN
  324.   END IF
  325.   record=VAL(c$)
  326.   IF record<1 OR record>an THEN
  327.     WINDOW CLOSE 4:GOSUB Info:LOCATE 3,1:COLOR 3
  328.     PRINT"Nur Etikett ";:COLOR 1:PRINT"1 bis "an:GOSUB 650
  329.     WINDOW CLOSE 5:GOTO KarteSuchen
  330.   END IF
  331.   WINDOW CLOSE 4:r=record:GOSUB ModusSetzen:MENU ON:RETURN
  332. ModusSetzen:
  333.   IF RelOffen=0 THEN SetTitle mo$(0)
  334.   IF RelOffen=1 THEN SetTitle mo$(4)
  335. RETURN
  336. '------
  337. DatAus:
  338. '------
  339.   GOSUB ModusSetzen:GOSUB Kopfzeile:GOSUB Rahmen
  340.   MENU 1,0,1:MENU 1,3,1:MENU 2,1,1:MENU 2,2,1:MENU 3,0,1 
  341.   IF RelOffen=0 THEN GOSUB Oeffnen2
  342. Kal:              
  343.   IF r>an THEN r=an
  344.   IF r<1 THEN r=1
  345.   GET #2,r:GOSUB Loeschen
  346.   LOCATE 1,14:PRINT r
  347.   LOCATE 5,1:FOR f=0 TO m:PRINT SPC(14);a$(f):NEXT f
  348.   IF r=1 THEN 
  349.     MENU OFF:SOUND 1000,4,255,0:GOSUB Info:LOCATE 3,6:COLOR 3,0
  350.     PRINT ra$(1):COLOR 1:GOSUB 650:WINDOW CLOSE 5:MENU ON
  351.   END IF
  352.   IF r=an THEN 
  353.     MENU OFF:SOUND 1000,4,255,0:GOSUB Info:LOCATE 3,6:COLOR 3,0
  354.     PRINT ra$(2):COLOR 1:GOSUB 650:WINDOW CLOSE 5:MENU ON
  355.   END IF
  356.   IF tt=1 THEN tt=0:GOSUB ModusSetzen
  357. Wa4:
  358.   tst=MOUSE(0):WHILE MOUSE(0)=0:WEND:x=MOUSE(3):y=MOUSE(4):win=WINDOW(0)
  359.   IF win<>3 THEN Wa4
  360.   IF y>1 AND y<11 AND win=3 THEN
  361.     IF x>12 AND x<104 THEN GOSUB Aendern:GOTO Kal'ÄNDERN
  362.     IF x>114 AND x<206 THEN r=1 :GOTO Kal      'ANFANG
  363.     IF x>215 AND x<259  THEN r=r-1:GOTO Kal    '<<<
  364.     IF x>265 AND x<309 THEN
  365.       IF MOUSE(0)<0 THEN Wa4                   '<
  366.       r=r-1:GOTO Kal
  367.     END IF
  368.     IF x>315 AND x<359 THEN
  369.       IF MOUSE(0)<0 THEN Wa4                   '>
  370.       r=r+1:GOTO Kal
  371.     END IF
  372.     IF x>365 AND x<409 THEN r=r+1:GOTO Kal     '>>>
  373.     IF x>418 AND x<510 THEN r=an:GOTO Kal      'ENDE
  374.   ' IF x>520 AND x<612 THEN GOSUB xxx:GOTO Kal 'frei
  375.   END IF
  376.   IF y>14 AND y<24 AND win=3 THEN
  377.     IF x>12  AND x<206 THEN
  378.       IF MOUSE(0)<0 THEN Wa4
  379.       GOSUB EtiSuchen:GOTO Kal
  380.     END IF
  381.     IF x>215 AND x<409 THEN GOSUB EinEtikett
  382.     IF x>418 AND x<510 THEN GOSUB Fettdruck
  383.     IF x>520 AND x<612 THEN GOSUB Doppeldruck
  384.   END IF
  385. GOTO Wa4
  386. Fettdruck:
  387.   Requester"Fettdruck?","JA","  NEIN"
  388.   IF req=1 THEN Fett=1:Doppel=0:RETURN
  389.   IF req=2 THEN Fett=0:Doppel=0:RETURN
  390. Doppeldruck:
  391.   Requester"Doppeldruck?","JA","  NEIN"
  392.   IF req=1 THEN Doppel=1:Fett=0:RETURN
  393.   IF req=2 THEN Doppel=0:Fett=0:RETURN
  394. Aendern:
  395.   CALL ActivateWindow&(wpr&)
  396.   MENU OFF:SetTitle"Etikett ändern"
  397.   FOR f=0 TO m:f$(f)=a$(f):NEXT f
  398.   intext m,5,15,la(),f$(),3,0 
  399.   FOR f=0 TO m:LSET a$(f)=f$(f):NEXT:PUT #2,r
  400.   GOSUB Info:LOCATE 3,4:COLOR 3:PRINT"Etikett geändert":COLOR 1:GOSUB 650
  401.   WINDOW CLOSE 5:GOSUB ModusSetzen:MENU ON:RETURN
  402. '-----
  403. Laden:
  404. '-----
  405.   WINDOW 12,,(142,36)-(461,168),0,SNr 
  406.   openreq=1:qo=0:x=0:y=0:MENU 1,1,0:GOSUB MenuesAus
  407.   SetTitle mo$(8):pa1=0:qa=1
  408.   LINE (5,5)-(315,136),1,b:LINE (7,7)-(313,134),1,b
  409.   LINE (14,29)-(292,91),1,b:LINE (292,29)-(307,91),1,b  
  410.   LINE(292,29)-(307,49),1,b:LINE(292,71)-(307,91),1,b
  411.   LINE(294,31)-(305,47),2,bf:LINE(294,73)-(305,89),2,bf
  412.   LINE (13,99)-(307,113),1,b
  413.   LINE (14,116)-(154,131),1,b:LINE (16,118)-(152,129),2,bf
  414.   LINE (167,116)-(307,131),1,b:LINE (169,118)-(305,129),2,bf:COLOR 2,0
  415.   LOCATE 3,4:PRINT "Dateinamen":LOCATE 3,21:PRINT"Bytes"
  416.   LOCATE 3,31:PRINT "Blöcke":COLOR 1,2
  417.   LOCATE 16,9:PRINT"Öffnen":LOCATE 16,27:PRINT"Abbruch":COLOR 1,0
  418.   IF gespeichert=1 THEN
  419.     FOR i=0 TO anz:DirName$(i)="":DirSize&(i)=0:DirBlks&(i)=0:NEXT i
  420.     SetTitle "Verzeichnis lesen":Dir$="Daten":GOSUB GetDir
  421.     gespeichert=0:SortDir:SetTitle mo$(8)
  422.   END IF
  423.   FOR i=1 TO 7
  424.     IF DirSize&(i)=0 THEN lweiter
  425.     LOCATE 4+i,4:PRINT LEFT$(DirName$(i),14)
  426.     LOCATE 4+i,20:PRINT DirSize&(i)
  427.     LOCATE 4+i,30:PRINT DirBlks&(i)
  428.     lweiter:
  429.   NEXT i
  430. Wa6:
  431.   WHILE MOUSE(0)=0:GOSUB Paint4:SLEEP:WEND
  432.   tst=MOUSE(0):x=MOUSE(1):y=MOUSE(2):win=WINDOW(0)
  433.   IF win<>12 THEN Wa6
  434.   IF win=12 AND openreq=1 THEN
  435.     IF x>294 AND x<305 AND y>31 AND y<47 THEN
  436.       IF pa1=0 THEN xp=296:yp=33:PAINT(xp,yp),1,0:px=xp:py=yp:pa1=1
  437.       GOSUB Sab 'scroll ab
  438.     END IF
  439.     IF x>294 AND x<305 AND y>73 AND y<89 THEN
  440.       IF pa1=0 THEN xp=296:yp=75:PAINT(xp,yp),1,0:px=xp:py=yp:pa1=1
  441.       GOSUB Sauf 'scroll auf
  442.     END IF
  443.     IF x>16 AND x<152 AND y>118 AND y<129 THEN
  444.       xp=18:yp=120:PAINT(xp,yp),1,0:px=xp:py=yp:IF MOUSE(0)<0 THEN Wa6
  445.       GOTO DOpen 'Datei öffnen
  446.     END IF
  447.     IF x>169 AND x<305 AND y>118 AND y<129 THEN
  448.       xp=171:yp=120:PAINT(xp,yp),1,0:px=xp:py=yp:IF MOUSE(0)<0 THEN Wa6
  449.       GOTO OEnd 'Abbruch
  450.     END IF
  451.     IF x>14 AND x<292 AND y>29 AND y<91 THEN
  452.       IF MOUSE(0)<0 THEN Wa6
  453.       GOSUB PText 'Print Text in Req
  454.     END IF 
  455.   END IF
  456.   pa1=0
  457. GOTO Wa6
  458. Sab:
  459.   IF DirSize&(qa-1)=0 OR counter<7 OR qa=1 THEN RETURN
  460.   SCROLL (15,31)-(291,87),0,8
  461.   LOCATE 5,4:PRINT LEFT$(DirName$(qa-1),14)
  462.   LOCATE 5,20:PRINT DirSize&(qa-1)
  463.   LOCATE 5,30:PRINT DirBlks&(qa-1)
  464.   qa=qa-1:RETURN
  465. Sauf:
  466.   IF DirSize&(qa+7)=0 OR counter<7 OR qa=counter-6 THEN RETURN
  467.   SCROLL (15,31)-(291,87),0,-8
  468.   LOCATE 11,4:PRINT LEFT$(DirName$(qa+7),14)
  469.   LOCATE 11,20:PRINT DirSize&(qa+7)
  470.   LOCATE 11,30:PRINT DirBlks&(qa+7)
  471.   qa=qa+1:RETURN
  472. OEnd:
  473. IF RelOffen=0 THEN
  474.    openreq=0:CLS:GOSUB st
  475.    MENU 1,0,1:MENU 1,1,1:MENU 1,3,0:WINDOW CLOSE 12:MENU ON:RETURN
  476. END IF
  477. IF RelOffen=1 THEN
  478.   openreq=0:GOSUB ModusSetzen:WINDOW CLOSE 12:GOSUB MenuesAn:RETURN
  479. END IF
  480. Paint4:
  481.   PAINT(px,py),2,0:COLOR 1,2
  482.   LOCATE 16,9:PRINT"Öffnen":LOCATE 16,27:PRINT"Abbruch":COLOR 1,0
  483. RETURN
  484. PText:
  485.   qo=INT((y-31)/8)+qa
  486.   IF qo>counter THEN qo=counter
  487.   LINE(14,100)-(306,112),0,bf
  488.   LOCATE 14,4:PRINT LEFT$(DirName$(qo),14)
  489.   IF DirSize&(qo)=0 THEN RETURN
  490.   LOCATE 14,20:PRINT DirSize&(qo)
  491.   LOCATE 14,30:PRINT DirBlks&(qo)
  492. RETURN
  493. DOpen:
  494.   IF LEFT$(DirName$(qo),14)="" THEN Wa6
  495.   CLS:WINDOW CLOSE 12
  496.   IF RelOffen=1 THEN CLOSE #2:RelOffen=0:GOSUB Schliessen:SetTitle mo$(8)
  497.   dn$="Daten/"+DirName$(qo)
  498.   fe$="Daten/"+LEFT$(DirName$(qo),14)+suffix2$
  499.   Dateigroesse&=DirSize&(qo):GOSUB Oeffnen
  500.   FelderJN=1:openreq=0:GOSUB MenuesAn:r=1:GOTO DatAus
  501. '----------
  502. Schliessen:
  503. '----------
  504.   MENU OFF:SetTitle"Schließe Datei":CLS
  505.   FOR i=0 TO m:a$(i)="":f$(i)="":la(i)=0:NEXT i
  506.   dn$="":fe$=""
  507.   IF openreq=0 AND FelderJN=1 THEN
  508.     CLOSE #2:RelOffen=0:GOSUB mod7
  509.   END IF
  510.   Satzlaenge=0:la=0:an=0:m=0:FelderJN=0:Format=0:MENU ON
  511.   IF MENU(1)=3 THEN RETURN Wa1
  512. RETURN
  513. mod7:
  514.   CLS:GOSUB st:GOSUB MenuesAus:MENU 1,0,1:MENU 1,1,1:MENU 1,3,0
  515. RETURN
  516. '-------------
  517. DateiLoeschen:
  518. '-------------
  519.   MENU OFF:SetTitle mo$(9)
  520.   wt$="Dateinamen eingeben: ":GOSUB OpenWin4
  521.   c$=STRING$(14,32):getline 2,3,14,c$,3,0
  522.   c$=LEFT$(c$,p-1):FOR f=LEN(c$) TO 13:c$=c$+fuell$:NEXT f
  523.   IF abbruch=1 AND RelOffen=0 THEN
  524.     abbruch=0:WINDOW CLOSE 4:GOSUB st:MENU ON:RETURN
  525.   END IF
  526. IF abbruch=1 AND RelOffen=1 THEN
  527.    abbruch=0:WINDOW CLOSE 4:GOSUB ModusSetzen:MENU ON:RETURN
  528. END IF
  529. IF c$=STRING$(14,46) AND RelOffen=1 THEN
  530.   c$="":WINDOW CLOSE 4:GOSUB Info:LOCATE 3,5:COLOR 3,0:PRINT ra$(6)
  531.   GOSUB 650:WINDOW CLOSE 5:GOSUB ModusSetzen:MENU ON:RETURN
  532. END IF
  533. IF c$=STRING$(14,46) AND RelOffen=0 THEN
  534.   c$="":WINDOW CLOSE 4:GOSUB Info:LOCATE 3,5:COLOR 3,0:PRINT ra$(6)
  535.   GOSUB 650:WINDOW CLOSE 5:GOSUB st:MENU ON:RETURN
  536. END IF
  537.   WINDOW CLOSE 4:GOSUB Info
  538.   loesch$="Daten/"+c$+suffix$ :KILL loesch$
  539.   loesch$="Daten/"+c$+suffix2$:KILL loesch$
  540.   COLOR 3:PRINT"Datei:":COLOR 1
  541.   PRINT LEFT$(loesch$,14):PRINT" ist gelöscht."
  542.   GOSUB 650:WINDOW CLOSE 5:gespeichert=1
  543.   IF RelOffen=1 THEN GOSUB ModusSetzen:MENU ON:RETURN
  544.   IF RelOffen=0 THEN GOSUB st:MENU ON:RETURN
  545. '----
  546. Verz:
  547. '----
  548.   MENU OFF:WINDOW 8,,(205,40)-(425,185),0,SNr
  549.   FILES "Daten"
  550.   COLOR 3:PRINT:PRINT TAB(3)"Linke Maustaste drÜcken":COLOR 1
  551.   Vz:
  552.   tst=MOUSE(0):WHILE MOUSE(0)=0:WEND:x=MOUSE(1):y=MOUSE(2)
  553.   IF x>1 AND x<WINDOW(2) AND y>1 AND y<WINDOW(3) AND WINDOW(0)=8 THEN
  554.     WINDOW CLOSE 8:MENU ON:RETURN
  555.   END IF
  556.   GOTO Vz
  557. '---- 
  558. Ende:
  559. '----
  560.   SetTitle mo$(10)
  561.   Requester"Sicher?    ","JA","  NEIN"
  562.   ON req GOTO JaEnde,NeinEnde
  563. JaEnde:
  564.   MENU RESET:LIBRARY CLOSE:WINDOW CLOSE 3:CLOSE
  565.   IF bs=1 THEN SCREEN CLOSE SNr
  566.   SYSTEM
  567. NeinEnde:
  568.   IF RelOffen=0 AND FelderJN=0 THEN GOSUB st:RETURN
  569.   IF RelOffen=1 AND FelderJN=1 THEN DatAus  
  570. Ausgang:
  571.   CLOSE 7:GOSUB ModusSetzen:MENU ON:RETURN
  572. Printer:
  573.   OPEN "prt:" FOR OUTPUT AS 7:RETURN
  574. '----------
  575. EinEtikett:
  576. '----------
  577.   SetTitle Etikett$(Format-1)
  578.   Requester "Drucker OK?","JA","ABBRUCH"
  579.   IF req=1 THEN weiter3
  580.   IF req=2 THEN Ausgang
  581.   weiter3:
  582.   MENU OFF:GOSUB Printer
  583.   REM *** Ein Etikett 70x36
  584.   IF Format=1 THEN
  585.     GOSUB Info:LOCATE 2,2:COLOR 3:PRINT"DRUCKE ETIKETT";:COLOR 1:PRINT r
  586.     PRINT#7,RIS$;           :REM Reset
  587.     PRINT#7,DEN2$;          :REM LQ
  588.     FOR i=0 TO m:PRINT#7,a$(i):NEXT i
  589.     PRINT#7,""             :REM linefeed  
  590.   END IF
  591.   REM *** Ein Etikett 70X70
  592.   IF Format=2 THEN
  593.     GOSUB Info:LOCATE 2,2:COLOR 3:PRINT"DRUCKE ETIKETT";:COLOR 1:PRINT r
  594.     PRINT#7,RIS$;           :REM Reset
  595.     PRINT#7,DEN2$;          :REM LQ ein
  596.     PRINT#7,SHORP2$;        :REM Elite ein
  597.     FOR i=0 TO 1:PRINT#7,a$(i):NEXT i  :REM Daten auf RÜcks. Disk
  598.     PRINT#7,SUS4$;          :REM Tieftellen ein
  599.     PRINT#7,a$(2)           :REM Daten auf Schmalseite Disk
  600.     PRINT#7,SUS3$;          :REM Tiefstellen aus
  601.     PRINT#7,a$(3)           :REM Daten
  602.     PRINT#7,SHORP6$;        :REM Breitdruck ein
  603.     PRINT#7,a$(4)           :REM Diskettennummer
  604.     PRINT#7,SHORP5$;        :REM Breitdruck aus
  605.     FOR i=5 TO m:PRINT#7,a$(i):NEXT i  :REM Daten
  606.     PRINT#7,RIS$;           :REM Reset
  607.     FOR i=1 TO 2:PRINT#7,"":NEXT i
  608.   END IF
  609.   REM *** Ein Etikett 89X36
  610.   IF Format=3 THEN
  611.     GOSUB Info:LOCATE 2,2:COLOR 3:PRINT"DRUCKE ETIKETT";:COLOR 1:PRINT r
  612.     PRINT#7,RIS$;           :REM Reset
  613.     PRINT#7,DEN2$;          :REM LQ-Modus
  614.     PRINT#7,SHORP2$;        :REM Elite ein
  615.     FOR i=0 TO m:PRINT #7,a$(i):NEXT i
  616.     PRINT#7,RIS$;           :REM Reset
  617.     PRINT#7,""   
  618.   END IF
  619.   WINDOW CLOSE 5:GOTO Ausgang
  620. '-------
  621. Drucken:
  622. '-------
  623.   SetTitle"Alle Etiketten drucken"
  624.   Requester"Drucker OK?","JA","ABBRUCH"
  625.   IF req=1 THEN weiter4
  626.   IF req=2 THEN Ausgang
  627.   weiter4:
  628.   MENU OFF:GOSUB Printer
  629.   FOR record=1 TO an
  630.     GET #2,record
  631.     REM *** Alle Etiketten 70x36
  632.     IF Format=1 THEN
  633.       PRINT#7,RIS$;           :REM Reset
  634.       PRINT#7,DEN2$;          :REM LQ
  635.       PRINT#7,SHORP2$;        :REM Elite ein
  636.       FOR i=0 TO m:PRINT#7,a$(i):NEXT i
  637.       PRINT#7,""              :REM linefeed
  638.     END IF
  639.     REM *** Alle Etiketten 70X70
  640.     IF Format=2 THEN
  641.       PRINT#7,RIS$;           :REM Reset
  642.       PRINT#7,DEN2$;          :REM LQ ein
  643.       PRINT#7,SHORP2$;        :REM Elite ein
  644.       FOR i=0 TO 1:PRINT #7,a$(i):NEXT i  :REM Daten auf RÜcks. Disk
  645.       PRINT#7,SUS4$;          :REM Tieftellen ein
  646.       PRINT#7,a$(2)           :REM Daten auf Schmalseite Disk
  647.       PRINT#7,SUS3$;          :REM Tiefstellen aus
  648.       PRINT#7,a$(3)           :REM Daten
  649.       PRINT#7,SHORP6$;        :REM Breitdruck ein
  650.       PRINT#7,a$(4)           :REM Diskettennummer
  651.       PRINT#7,SHORP5$;        :REM Breitdruck aus
  652.       FOR i=5 TO m:PRINT #7,a$(i):NEXT i  :REM Daten
  653.       PRINT#7,RIS$;           :REM Reset
  654.       FOR i=1 TO 2:PRINT #7,"":NEXT i
  655.     END IF
  656.     REM *** Alle Etiketten 89X36
  657.     IF Format=3 THEN   
  658.       PRINT#7,RIS$;           :REM Reset
  659.       PRINT#7,DEN2$;          :REM LQ-Modus
  660.       PRINT#7,SHORP2$;        :REM Elite ein
  661.       FOR i=0 TO m:PRINT #7,a$(i):NEXT i
  662.       PRINT#7,RIS$;           :REM Reset
  663.       PRINT#7,""
  664.     END IF
  665.   NEXT record
  666.   WINDOW CLOSE 5:GOTO Ausgang
  667. '-----
  668. Farbe:
  669. '-----
  670.   Farbwahl
  671. RETURN
  672. OpenWin11:
  673.   MENU OFF:MENU 3,0,0:WINDOW 11,WinText$,(50,37)-(572,166),8,SNr
  674.   COLOR 0,1:CLS
  675. RETURN  
  676. Prg:
  677.   WinText$="Das Programm":GOSUB OpenWin11
  678.   LOCATE 2,5:PRINT Version$
  679.   LOCATE 4,4:PRINT" Von Lothar Berndt, 4240 Emmerich 1"
  680.   LOCATE 6,4:PRINT" Erstellt im Jahre 1988, 1989, 1990" 
  681.   LOCATE 8,4:PRINT n"Etiketten pro Datei"
  682.   LOCATE 10,4:PRINT" Drei Etikettenformate 70 X 36, 70 X 70 und 89 X 36 mm"
  683. GOTO modus6
  684. Datei:
  685.   WinText$="Datei":GOSUB OpenWin11
  686.   LOCATE 2,5:PRINT"Aktuelle Datei..............: "LEFT$(dn$,20)
  687.   LOCATE 3,5:PRINT"Dateigröße in Bytes.........:";Dateigroesse&
  688.   LOCATE 4,5:PRINT"Feie Bytes Systemspeicher...:"FRE(-1)
  689.   LOCATE 5,5:PRINT"Anzahl Datensätze...........:";an
  690.   LOCATE 6,5:PRINT"Datensatzlänge..............:";Satzlaenge 
  691.   LOCATE 7,5:PRINT"Anzahl Felder...............:";m+1
  692.   LOCATE 8,5:PRINT"Feldlänge...................:";la
  693. GOTO modus6
  694. Eti:
  695.   WinText$="Etikettendruck":GOSUB OpenWin11
  696.   LOCATE 4,5:PRINT"Der Bezugspunkt für das erste Etikett ist:"
  697.   LOCATE 6,5:PRINT"Setzen Sie die Etikettoberkante bündig"
  698.   LOCATE 7,5:PRINT"mit der Farbbandoberkante."
  699. GOTO modus6
  700. Tas:
  701.   WinText$="Tastaturbelegung beim eingeben/ändern":GOSUB OpenWin11
  702.   PRINT  
  703.   PRINT " RETURN       = ein Feld tiefer, leere Felder werden als"
  704.   PRINT "                Leerfelder gesichert ( chr$(32) )!"
  705.   PRINT " CURSORTASTEN = ab, auf, rechts, links."
  706.   PRINT " DEL          = löscht ein Zeichen unter dem Cursor"
  707.   PRINT "                nachfolgende Zeichen rücken nach links."
  708.   PRINT " BACKSPACE    = löscht ein Zeichen links vom Cursor,"
  709.   PRINT "                nachfolgende Zeichen rücken nach links."
  710.   PRINT " F10          = löscht das aktuelle Feld (wo der Cursor ist)."
  711.   PRINT " ESC          = erzwingt den Abbruch der Eingabe im aktuellen"
  712.   PRINT "                Feld. Da die Felder vorher mit Leerzeichen"
  713.   PRINT "                gefüllt wurden, werden leere Felder als"
  714.   PRINT "                Leerfelder gesichert (wie bei RETURN)!"
  715.   PRINT " SPACE        = schiebt den Text rechts vom Cursor nach rechts."
  716.   PRINT " LINKE MAUST. = positioniert den Cursor wo d. Mauszeiger steht.";
  717. modus6:
  718.   WHILE (WINDOW(7)<>0 AND WINDOW(1)=11):WEND
  719.   WINDOW CLOSE 11:WINDOW OUTPUT WNr:MENU 3,0,1:MENU ON:tst=MOUSE(0)
  720.   COLOR 1,0:RETURN
  721. '------
  722. Fehler:
  723. '------
  724.   MENU OFF
  725.   IF ERR=14 THEN Fehler$="Arbeitsspeicher nicht ausreichend."
  726.   IF ERR=49 THEN Fehler$="Legen Sie die Diskette in das Laufwerk!"
  727.   IF ERR=52 THEN Fehler$="Falsche Dateinummer."
  728.   IF ERR=53 THEN Fehler$="Datei nicht gefunden."
  729.   IF ERR=54 THEN Fehler$="Falscher Dateityp."
  730.   IF ERR=55 THEN Fehler$="Die Datei ist bereits geöffnet."
  731.   IF ERR=57 THEN Fehler$="Geräte Ein- Ausgabefehler."
  732.   IF ERR=61 THEN Fehler$="Diskette ist voll."
  733.   IF ERR=62 THEN Fehler$="Eingabe nach logischem Dateiende."
  734.   IF ERR=63 THEN Fehler$="UngÜltige Satznummer."
  735.   IF ERR=64 THEN Fehler$="Ungültiger Dateiname."
  736.   IF ERR=68 THEN Fehler$="Gerät ist nicht verfÜgbar."
  737.   IF ERR=70 THEN Fehler$="Diskette ist schreibgeschÜtzt."
  738.   IF ERR=74 THEN Fehler$="Unbekannte Diskette."
  739.   IF ERR=75 THEN Fehler$="Verzeichnis existiert nicht!"
  740.   IF ERR=76 THEN Fehler$="Kein Speicherplatz frei!"
  741.   IF ERR=77 THEN Fehler$="Verzeichnis konnte nicht gefunden werden!
  742.   WINDOW 99,,(0,150)-(630,185),0,SNr
  743.   LOCATE 1,3:PRINT"Es ist ein Fehler aufgetreten."
  744.   LOCATE 3,3:COLOR 3:PRINT ERR;" ";Fehler$:COLOR 1
  745.   LOCATE 5,3:PRINT"Beheben Sie den Fehler und drÜcken danach die Taste 'W'.";
  746. Wa5: x$=INKEY$:IF x$="" THEN Wa5
  747.   IF UCASE$(x$)<>"W" THEN Wa5
  748.   WINDOW CLOSE 99:Fehler$="":MENU ON
  749.   IF ERR=49 OR ERR=61 OR ERR=70 THEN
  750.     RESUME
  751.   ELSE
  752.     RESUME FehlerEnd
  753.   END IF
  754. FehlerEnd:
  755.   ON ERROR GOTO 0:WINDOW WNr:CLS:GOSUB Schliessen:GOSUB mod7
  756.   WinText$="<--- WEITER":GOSUB OpenWin11:COLOR 3,1:PRINT 
  757.   PRINT TAB(26)"KEINE PANIK":COLOR 0,1:LOCATE 5
  758.   PRINT TAB(10)"Es ist ein Fehler aufgetreten, den ich nicht":PRINT 
  759.   PRINT TAB(7)"beheben konnte. Nach dem schließen dieses Fensters":PRINT 
  760.   PRINT TAB(10)"können Sie eine Datei öffnen oder einrichten."
  761.   GOSUB modus6:ON ERROR GOTO Fehler
  762. RETURN Wa1
  763. '--------
  764. ControlC:
  765. '--------
  766. MENU RESET:LIBRARY CLOSE:WINDOW CLOSE 3:WINDOW CLOSE 1:CLOSE
  767. IF bs=1 THEN SCREEN CLOSE SNr
  768. WINDOW 1,"BASIC",(0,0)-(617,241),31,-1
  769. END
  770. '--------------------------
  771. '*** Sub Unterprogramme ***
  772. '--------------------------
  773. SUB xyPTAB (x,y) STATIC:POKEW WINDOW(8)+36,x:POKEW WINDOW(8)+38,y:END SUB
  774. SUB Dateitest (DNa$,Flag&) STATIC 'dos.bmap
  775.     ln$=DNa$+CHR$(0)
  776.     Flag&=Lock&(SADD(ln$),-2)
  777.     CALL UnLock&(Flag&)
  778. END SUB  
  779. SUB SetTitle (wind$) STATIC 'intuition.bmap
  780.   SHARED wpr&:wind$=wind$+CHR$(0):wt&=SADD(wind$)
  781.   CALL SetWindowTitles&(wpr&,wt&,-1)
  782. END SUB
  783. SUB Requester (me$,m1$,m2$) STATIC
  784.   SHARED req,SNr:MENU OFF
  785.   WINDOW 7,"Requester",(218,123)-(406,173),0,SNr
  786.   LOCATE 2,2:PRINT me$
  787.   LINE(14,28)-(80,42),2,bf:LINE(110,28)-(176,42),2,bf:COLOR 1,2
  788.   LOCATE 5,1:PRINT PTAB(38)m1$;PTAB(116)m2$;:COLOR 1,0
  789.   Wa11:
  790.   tst=MOUSE(0):WHILE MOUSE(0)=0:WEND:x=MOUSE(3):y=MOUSE(4)
  791.   IF WINDOW(0)=7 AND y>28 AND y<42 THEN
  792.     IF x>14 AND x<80 THEN req=1:GOTO EndeSubr   :REM JA
  793.     IF x>110 AND x<176 THEN req=2:GOTO EndeSubr :REM NEIN
  794.   END IF
  795.   GOTO Wa11
  796.   EndeSubr:
  797.   WINDOW CLOSE 7:MENU ON
  798. END SUB
  799.  'Anzahl Zeilen-1,Zeile,Spalte,Laenge(),Daten$(),Cursorfarbe,Hintergrundf.
  800. SUB intext (zeilen,ze,sp,laenge(),x$(),Cf,Hf) STATIC
  801.   SHARED l,p:l=0:p=1:d$="":d=0:liz=0
  802.   FOR i=1 TO 15:d$=INKEY$:d$="":NEXT i :REM Tastaturpuffer leeren
  803. getkey:
  804.   COLOR 1,Cf:LOCATE ze+l,sp+p-1:PRINT MID$(x$(l),p,1);
  805.   IF MOUSE(0)<0 THEN
  806.     x=MOUSE(1):y=MOUSE(2)
  807.     IF x>(sp-1)*8 AND x<(sp+laenge(l))*8 OR x>(sp+laenge(l))*8 THEN
  808.       IF y>(ze-1)*8 AND y<(ze+zeilen)*8 THEN
  809.         COLOR 1,Hf:LOCATE ze+l,sp+p-1:PRINT MID$(x$(l),p,1);
  810.         p=INT(x/8)-sp+2:l=INT(y/8)-ze+1
  811.         IF p>laenge(l) THEN p=laenge(l):GOTO getkey
  812.       END IF
  813.     END IF
  814.   END IF
  815.   d$=INKEY$:IF d$="" THEN SLEEP:GOTO getkey
  816.   IF d$=CHR$(34) THEN d$=CHR$(39)
  817.   d=ASC(d$)
  818.   COLOR 1,Hf:LOCATE ze+l,sp+p-1:PRINT MID$(x$(l),p,1);
  819.   IF d>127 AND d<138 OR d>138 AND d<160 THEN getkey
  820.   IF d>0 AND d<8 OR d>8 AND d<13 OR d>13 AND d<27 THEN getkey
  821.   IF d$=CHR$(27) THEN
  822.     IF liz=1 THEN liz=0:p=laenge(l)+1
  823.     EXIT SUB
  824.   END IF
  825.   IF d$=CHR$(13) THEN
  826.     IF liz=1 THEN liz=0:p=laenge(l)+1
  827.     IF l=zeilen THEN EXIT SUB
  828.     p=1:l=l+1:GOTO getkey
  829.   END IF
  830.   IF d$=CHR$(8) THEN
  831.     IF p>1 THEN
  832.       p=p-1
  833.       x$(l)=LEFT$(x$(l),p-1)+MID$(x$(l),p+1)+" "
  834.       LOCATE ze+l,sp:PRINT x$(l):GOTO getkey
  835.       ELSE
  836.       GOSUB Sod1:GOTO getkey
  837.     END IF
  838.   END IF
  839.   IF d$=CHR$(127) THEN
  840.     IF p>=1 THEN
  841.       x$(l)=LEFT$(x$(l),p-1)+MID$(x$(l),p+1)+" "
  842.       LOCATE ze+l,sp:PRINT x$(l):GOTO getkey
  843.       ELSE
  844.       GOSUB Sod1:GOTO getkey
  845.     END IF
  846.   END IF
  847.   IF d$=CHR$(138) THEN
  848.     x$(l)=SPACE$(laenge(l)):LOCATE ze+l,sp:PRINT x$(l):p=1
  849.     GOTO getkey
  850.   END IF
  851.   ON INSTR(CHR$(28)+CHR$(29)+CHR$(30)+CHR$(31),d$)GOTO auf,ab,rechts,links
  852.   IF RIGHT$(x$(l),laenge(l)+1-p)=SPACE$(laenge(l)+1-p) THEN
  853.     MID$(x$(l),p,1)=d$:LOCATE ze+l,sp+p-1:PRINT d$;
  854.     ELSE
  855.     x$(l)=LEFT$(x$(l),p-1)+d$+MID$(x$(l),p,laenge(l)-p)
  856.     LOCATE ze+l,sp:PRINT x$(l) 
  857.   END IF
  858.   IF p=laenge(l) THEN GOSUB Sod1:liz=1:GOTO getkey
  859.   p=p+1  
  860. GOTO getkey
  861. auf:
  862.   IF l=0 THEN GOSUB Sod1:GOTO getkey
  863.   l=l-1
  864.   IF p>laenge(l) THEN p=laenge(l)
  865.   GOTO getkey
  866. ab:
  867.   IF l=zeilen THEN GOSUB Sod1:GOTO getkey
  868.   l=l+1
  869.   IF p>laenge(l) THEN p=laenge(l)
  870.   GOTO getkey
  871. rechts:
  872.   IF p=laenge(l) THEN GOSUB Sod1:GOTO getkey
  873.   p=p+1:GOTO getkey
  874. links:
  875.   IF p=1 THEN GOSUB Sod1:GOTO getkey
  876.   p=p-1:GOTO getkey
  877. Sod1: SOUND 1000,4,255,0:RETURN
  878. END SUB
  879.     'Zeile,Spalte,AnzahlZeichen,Dat$,Cursorfarbe,Hintergrundfarbe
  880. SUB getline (ze,sp,AnzZ,txt$,Cf,Hf) STATIC
  881.   SHARED abbruch,p:p=1:liz=0:d$="":d=0:LOCATE ze,sp:PRINT txt$
  882.   FOR i=1 TO 15:d$=INKEY$:d$="":NEXT i:REM Tastaturpuffer leeren
  883.   getk:
  884.   COLOR 1,Cf:LOCATE ze,sp+p-1:PRINT MID$(txt$,p,1);
  885.   tst=MOUSE(0)
  886.   IF MOUSE(0)<0 THEN
  887.     x=MOUSE(1):y=MOUSE(2)
  888.     IF x>(sp-1)*8 AND x<(sp+AnzZ)*8 THEN
  889.       IF y>(ze-1)*8 AND y<ze*8 THEN
  890.         COLOR 1,Hf:LOCATE ze,sp+p-1:PRINT MID$(txt$,p,1);
  891.         p=INT(x/8)-sp+2:IF p>AnzZ THEN p=AnzZ:GOTO getk
  892.       END IF
  893.     END IF
  894.     IF y>28 AND y<42 AND WINDOW(0)=4 THEN
  895.       IF x>14 AND x<80 THEN abbruch=0:GOTO ausg 'Klick in OK
  896.       IF x>110 AND x<176 THEN abbruch=1:d$="":GOTO ausg 'Klick in ABBR.
  897.     END IF
  898.   END IF
  899.   d$=INKEY$:IF d$="" THEN SLEEP:GOTO getk
  900.   IF d$=CHR$(34) THEN d$=CHR$(39)
  901.   d=ASC(d$)
  902.   COLOR 1,Hf:LOCATE ze,sp+p-1:PRINT MID$(txt$,p,1);
  903. IF d>127 AND d<138 OR d>138 AND d<160 THEN getk
  904. IF d>0 AND d<8 OR d>8 AND d<13 OR d>13 AND d<27 OR d>27 AND d<30 THEN getk
  905.   IF d$=CHR$(13) THEN
  906.     IF liz=1 THEN liz=0:p=AnzZ+1
  907.     ausg:
  908.     EXIT SUB
  909.   END IF
  910.   IF d$=CHR$(8) THEN
  911.     IF p>1 THEN
  912.       p=p-1:txt$=LEFT$(txt$,p-1)+MID$(txt$,p+1)+" "
  913.       LOCATE ze,sp:PRINT txt$:GOTO getk
  914.        ELSE
  915.       GOSUB Sod3:GOTO getk
  916.     END IF
  917.   END IF
  918.   IF d$=CHR$(30) THEN
  919.     IF p=AnzZ THEN GOSUB Sod3:GOTO getk
  920.     p=p+1:GOTO getk
  921.   END IF
  922.   IF d$=CHR$(31) THEN
  923.     IF p=1 THEN GOSUB Sod3:GOTO getk
  924.     p=p-1:GOTO getk
  925.   END IF
  926.   IF d$=CHR$(127) THEN
  927.    IF p>=1 THEN
  928.      txt$=LEFT$(txt$,p-1)+MID$(txt$,p+1)+" "
  929.      LOCATE ze,sp:PRINT txt$:GOTO getk
  930.      ELSE
  931.      GOSUB Sod3:GOTO getk
  932.    END IF
  933.   END IF
  934.   IF d$=CHR$(138) THEN
  935.     txt$=SPACE$(AnzZ):LOCATE ze,sp:PRINT txt$
  936.     p=1:GOTO getk
  937.   END IF
  938.   MID$(txt$,p,1)=d$:LOCATE ze,sp:PRINT txt$
  939.   IF p=AnzZ THEN GOSUB Sod3:liz=1:GOTO getk
  940.   p=p+1:GOTO getk
  941. Sod3: SOUND 1000,4,255,0:RETURN
  942. END SUB
  943. SUB SortDir STATIC
  944.   SHARED counter
  945.   FOR sort1=1 TO counter:FOR sort2=sort1+1 TO counter-1
  946.   IF UCASE$(DirName$(sort1))>UCASE$(DirName$(sort2)) THEN
  947.     SWAP DirName$(sort1),DirName$(sort2)
  948.     SWAP DirSize&(sort1),DirSize&(sort2)
  949.     SWAP DirBlks&(sort1),DirBlks&(sort2)
  950.   END IF
  951.   NEXT sort2:NEXT sort1
  952. END SUB
  953. REM Subroutine Farbwahl, aus Amiga 4/88/Seite 83
  954. SUB Farbwahl STATIC
  955.   SHARED SNr:feldx=WINDOW(2)/10:feldy=WINDOW(3)/4:bahn=feldy/7
  956.   WINDOW 88,,(feldx,feldy)-(9*feldx,3.25*feldy+25),0,SNr
  957.   fx=WINDOW(2):fy=WINDOW(3)
  958.   Farbzahl=WINDOW(6)
  959.   IF dimflag=0 THEN DIM Farbwert!(Farbzahl,3):dimflag=1
  960.   Tabellenanfang&=PEEKL(4+PEEKL(4+(44+PEEKL(WINDOW(7)+46))))
  961.   FOR i=0 TO Farbzahl:Farbwert!(i,0)=PEEKW(Tabellenanfang&+2*i):NEXT i
  962. Farbspeicher:
  963.   aktivfarbe=0:COLOR 1,0
  964.   py%=2*(feldy+bahn):px%=2*(feldx-bahn):GOSUB curpos:PRINT "RESET"
  965.   px%=6*feldx-bahn:GOSUB curpos:PRINT "OK"
  966.   py%=2*(feldy+bahn+11):px%=2*(feldx-bahn-7):GOSUB curpos:PRINT "GRUNDWERTE";
  967.   py%=2*(feldy+bahn+11):px%=6*(feldx-bahn):GOSUB curpos:PRINT "ABBRUCH";
  968.   FOR i=0 TO Farbzahl:hd!=Farbwert!(i,0)
  969.   FOR J=1 TO 3
  970.   hx!=hd!\16^(3-J):hd!=hd!-hx!*16^(3-J)
  971.   Farbwert!(i,J)=INT(hx!*6.667)/100
  972.   NEXT J
  973.   PALETTE i,Farbwert!(i,1),Farbwert!(i,2),Farbwert!(i,3)
  974.   LINE(i*8*feldx/(Farbzahl+1),feldy)-((i+1)*8*feldx/(Farbzahl+1),2*feldy),i,bf
  975.   NEXT i
  976.   LINE(0,0)-(8*feldx,2.5*feldy),1,b
  977.   LINE(0,feldy)-(8*feldx,2*feldy),1,b
  978.   LINE(4*feldx,2*feldy)-(4*feldx,2.5*feldy)
  979.   LINE(4*feldx,2*feldy+30)-(4*feldx,2.65*feldy+1)
  980.   GOSUB reglerfeld
  981. mcheck:
  982.   Flag=MOUSE(0)
  983.   IF Flag THEN GOSUB farbfeldwahl
  984.   IF Flag<0 THEN GOSUB regeln
  985.   GOTO mcheck
  986. regeln:
  987.   IF MOUSE(2)>feldy-bahn OR MOUSE(2)<bahn THEN RETURN
  988.   i=(MOUSE(2)-6)\(bahn*2)+1
  989.   posx!=MOUSE(1)
  990.   IF posx!<2*feldx OR posx!>6*feldx THEN RETURN
  991.   py%=bahn*i*2:GOSUB regler1
  992.   RETURN
  993. farbfeldwahl:
  994.   y=MOUSE(4):IF y<feldy OR y>3*feldy THEN RETURN
  995.   x=MOUSE(3):IF x<0 OR x>feldx*8 THEN RETURN
  996.   IF x>feldx/30 AND x<feldx*4 AND y>fy-23 AND y<fy THEN Grundwerte
  997.   IF x>feldx*4 AND x<feldx*8 AND y>fy-23 AND y<fy THEN WINDOW CLOSE 88:EXIT SUB    
  998.   IF y<2*feldy THEN
  999.     aktivfarbe=INT(x/(8*feldx/(Farbzahl+1)))
  1000.     GOSUB reglerfeld:RETURN
  1001.   END IF
  1002. IF x<4*feldx THEN Farbspeicher
  1003. 'Farbwerte auf Diskette speichern
  1004.   WINDOW CLOSE 88:MOUSE ON
  1005.   OPEN "Farbdaten" FOR OUTPUT AS 1
  1006.   PRINT#1,Farbzahl
  1007.   FOR i=0 TO Farbzahl:FOR J=1 TO 3:PRINT#1,Farbwert!(i,J):NEXT J,i
  1008.   CLOSE 1
  1009.   EXIT SUB
  1010. RETURN
  1011. Grundwerte:  
  1012.   RESTORE Grunddaten
  1013.   READ Farbzahl
  1014.   FOR i=0 TO Farbzahl
  1015.     FOR J=1 TO 3
  1016.       READ Farbwert!(i,J)
  1017.     NEXT J
  1018.     PALETTE i,Farbwert!(i,1),Farbwert!(i,2),Farbwert!(i,3)
  1019.   NEXT i
  1020. RETURN
  1021. reglerfeld:
  1022.   LINE (0,0)-(8*feldx,feldy),aktivfarbe,bf
  1023.   LINE (0,0)-(8*feldx,feldy),1,b
  1024.   zfarbe=Farbzahl-aktivfarbe
  1025.   COLOR zfarbe,aktivfarbe
  1026.   RESTORE reglerfeld: DATA ROT,GR<0x5c>N,BLAU
  1027.   px%=feldx-bahn
  1028.   FOR i=1 TO 3
  1029.     py%=bahn*i*2:GOSUB curpos:READ m$:PRINT m$
  1030.     posx!=Farbwert!(aktivfarbe,i)*feldx*4+2*feldx
  1031.     GOSUB regler2
  1032.     LINE (feldx*2-1,py%+2)-(feldx*6+1,py%-bahn-2),zfarbe,b
  1033.   NEXT
  1034. RETURN
  1035. regler1:
  1036.   Farbwert!(aktivfarbe,i)=INT((posx!-feldx*2)/feldx*25)/100
  1037.   PALETTE aktivfarbe,Farbwert!(aktivfarbe,1),Farbwert!(aktivfarbe,2),Farbwert!(aktivfarbe,3)
  1038. regler2:
  1039.   LINE (posx!,py%)-(feldx*6,py%-bahn),aktivfarbe,bf
  1040.   LINE (feldx*2,py%)-(posx!,py%-bahn),zfarbe,bf
  1041.   px%=feldx*6+bahn:GOSUB curpos
  1042.   PRINT Farbwert!(aktivfarbe,i);" "
  1043.   px%=feldx-bahn
  1044. RETURN
  1045. curpos:
  1046.   POKEW WINDOW(8)+36,px%:POKEW WINDOW(8)+38,py%:RETURN
  1047. Grunddaten:
  1048. DATA 3,0,0,0,.66,.66,.66,0,.54,0,1,.53,0
  1049. END SUB
  1050. SUB dos.lib STATIC
  1051.  OPEN "ram:dos.bmap" FOR OUTPUT AS 1
  1052.  PRINT#1,"Lock";CHR$(0);CHR$(255);CHR$(172);CHR$(2);CHR$(3);CHR$(0);
  1053.  PRINT#1,"UnLock";CHR$(0);CHR$(255);CHR$(166);CHR$(2);CHR$(0);
  1054.  PRINT#1,"Examine";CHR$(0);CHR$(255);CHR$(154);CHR$(2);CHR$(3);CHR$(0);
  1055.  PRINT#1,"ExNext";CHR$(0);CHR$(255);CHR$(148);CHR$(2);CHR$(3);CHR$(0);
  1056.  PRINT#1,"IoErr";CHR$(0);CHR$(255);CHR$(124);CHR$(0);
  1057.  PRINT#1,"Execute";CHR$(0);CHR$(255);CHR$(34);CHR$(2);CHR$(3);CHR$(4);CHR$(0);
  1058.  CLOSE 1
  1059.  LIBRARY "RAM:dos.library"
  1060.  KILL "RAM:dos.bmap"
  1061. END SUB
  1062. SUB intuition.lib STATIC
  1063.  OPEN "ram:intuition.bmap" FOR OUTPUT AS 1
  1064.  PRINT#1,"SetWindowTitles";CHR$(0);CHR$(254);CHR$(236);CHR$(9);CHR$(10);CHR$( 11);CHR$(0);
  1065.  PRINT#1,"SizeWindow";CHR$(0);CHR$(254);CHR$(224);CHR$(9);CHR$(1);CHR$(2);CHR$(0);
  1066.  PRINT#1,"WindowToBack";CHR$(0);CHR$(254);CHR$(206);CHR$(9);CHR$(0);
  1067.  PRINT#1,"WindowToFront";CHR$(0);CHR$(254);CHR$(200);CHR$(9);CHR$(0);
  1068.  PRINT#1,"WindowLimits";CHR$(0);CHR$(254);CHR$(194);CHR$(9);CHR$(1);CHR$(2);CHR$( 3);CHR$(4);CHR$(0);
  1069.  PRINT#1,"AllocRemember";CHR$(0);CHR$(254);CHR$(116);CHR$(9);CHR$(1);CHR$(2);CHR$(0);
  1070.  PRINT#1,"FreeRemember";CHR$(0);CHR$(254);CHR$(104);CHR$(9);CHR$(1);CHR$(0);
  1071.  PRINT#1,"ActivateWindow";CHR$(0);CHR$(254);CHR$(62);CHR$(9);CHR$(0);
  1072.  CLOSE 1
  1073.  LIBRARY "RAM:intuition.library"
  1074.  KILL "RAM:intuition.bmap"
  1075. END SUB
  1076.  
  1077.